home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 18 / 018.d81 / com64 grapher (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  7KB  |  240 lines
  1. 10 dimg(60),c(60):z=0:x=0
  2. 11 df=0: rem  is data present?
  3. 15 poke53280,6:poke53281,3:printchr$(147):poke646,0
  4. 20 co=7:ro=4:gosub790:print"*** com 64 grapher menu ***"
  5. 25 print:print:printtab(11)chr$(18)"s"chr$(146)"tart new graph file"
  6. 30 print:printtab(11)chr$(18)"r"chr$(146)"ead file from disc"
  7. 35 print:printtab(11)chr$(18)"w"chr$(146)"rite file to disk"
  8. 40 print:printtab(11)chr$(18)"a"chr$(146)"dd to existing data"
  9. 45 print:printtab(11)chr$(18)"c"chr$(146)"hange prior entry"
  10. 50 print:printtab(11)chr$(18)"f"chr$(146)"ormat change"
  11. 55 print:printtab(11)chr$(18)"l"chr$(146)"ist current data"
  12. 60 print:printtab(11)chr$(18)"g"chr$(146)"raph data"
  13. 62 print:printtab(11)chr$(18)"q"chr$(146)"uit"
  14. 65 geta$:ifa$=""then65
  15. 66 ifa$="q"then63000
  16. 70 ifa$="s"thenz=o:cc=1:goto115
  17. 75 ifa$="r"thengosub520:goto15
  18. 80 ifa$="a"thenifdf<>0then printchr$(147):n=e:cc=c(n-1)+1:goto176
  19. 82 ifa$="a"thengosub60000:goto15
  20. 85 ifa$="w"thengosub445:goto15
  21. 90 ifa$="l"thengosub615:zz=e-1:goto15
  22. 95 ifa$="c"thenifdf<>0then705
  23. 96 ifa$="c"thengosub60000:goto15
  24. 100 ifa$="g"then245
  25. 105 ifa$="f"thengosub755:goto15
  26. 110 goto15
  27. 115 ifx>0then65
  28. 117 df=1
  29. 120 printchr$(147):co=2:ro=1:gosub790
  30. 122 print"name of graph: ";:gosub950:t$=b$
  31. 125 print:printtab(2)"minimum value for bottom axis: ";:u=1:gosub950:b=val(b$)
  32. 130 print:printtab(2)"value of vertical interval: ";:u=1:gosub950
  33. 132 s=val(b$)
  34. 135 print:printtab(2)"name of bottom axis: ";:gosub950:x$=b$
  35. 140 print:printtab(2)chr$(156)"all bars the same color  - press 'a'"
  36. 145 print:printtab(2)"different colored bars   - press 'b'"
  37. 150 get a$:ifa$=""then150
  38. 155 ifa$="a"thenz=1:forv=1to60:c(v)=2:next:goto170
  39. 160 ifa$="b"then170
  40. 165 goto150
  41. 170 n=1:print:printtab(2)chr$(30)"input up to 60 values"
  42. 175 print:printtab(2)"type '-1' to end input"
  43. 176 co=2:ro=17:gosub790
  44. 177 ifdf=0thengosub60000:goto15
  45. 178 printchr$(28)"range of graph is"b"to"b+5*s;chr$(144)
  46. 180 co=2:ro=20:gosub790
  47. 182 print"value to be graphed,bar #";n;"             ";
  48. 185 co=32:ro=20:gosub790:u=1:gosub950:g(n)=val(b$)
  49. 190 gn=g(n)
  50. 192 ifgn<>-1andgn<borgn>b+5*sthenco=2:r0=20:gosub790:gosub780:goto180
  51. 195 ifgn=-1thenw=0:e=n:goto15
  52. 200 ifz=1thenc(n)=2
  53. 205 ifz=1andn=60thenw=0:goto15
  54. 210 ifgn<borgn>b+5*sthen180
  55. 215 ifz=1thenn=n+1:goto180
  56. 220 ifcc=11thencc=1
  57. 225 c(n)=cc
  58. 230 cc=cc+1
  59. 235 ifn=60then15
  60. 240 n=n+1:goto180
  61. 245 ifdf=0thengosub60000:goto15
  62. 246 fl=0:forck=0toe:ifg(ck)>b+5*sthenfl=1
  63. 247 nextck
  64. 248 iffl=1thengosub61000
  65. 249 w=0:poke53280,0:poke53281,0:poke646,5
  66. 250 printchr$(147)tab(8+(32-int(len(t$)))/2)t$
  67. 255 forp=1to20:co=1:ro=p:gosub790
  68. 260 printtab(7)"[180]                              [167]":next
  69. 265 co=1:ro=21:gosub790:printb;tab(7)"[204][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][186]"
  70. 270 forp=1to4:co=1:ro=21-4*p:gosub790
  71. 275 printb+p*s;tab(7)"[204][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][186]"
  72. 280 next
  73. 285 co=1:ro=1:gosub790
  74. 290 printb+5*s;tab(7)"[175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175]"
  75. 295 ifw<>0then305
  76. 300 x=1
  77. 305 ifg(x)=-1thenc(x)=2:goto355
  78. 310 y=int(4*(g(x)-b)/s)
  79. 315 ls=1871:lc=56143
  80. 316 forr=0to(y-1)
  81. 317 l1=ls+2*(x-15*w)-40*r
  82. 318 l2=lc+2*(x-15*w)-40*r
  83. 319 ifl1<1064thenr=y-1:goto325
  84. 320 pokel1,160:pokel2,c(x)
  85. 325 nextr
  86. 330 ifx=15then355
  87. 335 ifx=30then355
  88. 340 ifx=45then355
  89. 345 ifx=60then355
  90. 350 x=x+1:goto305
  91. 355 co=(40-len(x$))/2:ro=23:gosub790:printx$;
  92. 360 ifw<>0thengosub415:goto375
  93. 365 co=9:row=22:gosub790:print"1 2 3 4 5 6 7 8 9 1 1 1 1 1 1";
  94. 370 co=27:ro=23:gosub790:print"0 1 2 3 4 5";:printchr$(158);
  95. 375 co=0:ro=24:gosub790:print"press:'p' to print  -  any key to go on";
  96. 380 get a$:if a$=""then380
  97. 385 ifa$="p"thengosub815
  98. 390 ifx=15andx<e-1thenw=1:x=x+1:poke646,5:goto250
  99. 395 ifx=30andx<e-1thenw=2:x=x+1:poke646,5:goto250
  100. 400 ifx=45andx<e-1thenw=3:x=x+1:poke646,5:goto250
  101. 405 ifx=15orx=30orx=45andx=e-1then15
  102. 410 goto15
  103. 415 ifw=1thenco=9:ro=22:gosub790:print"1 1 1 1 2 2 2 2 2 2 2 2 2 2 3"
  104. 420 ifw=1thenprinttab(9)"6 7 8 9 0 1 2 3 4 5 6 7 8 9 0";
  105. 422 ifw=1thenprintchr$(158);:return
  106. 425 ifw=2thenco=9:ro=22:gosub790:print"3 3 3 3 3 3 3 3 3 4 4 4 4 4 4"
  107. 430 ifw=2thenprinttab(9)"1 2 3 4 5 6 7 8 9 0 1 2 3 4 5";
  108. 432 ifw=2thenprintchr$(158);:return
  109. 435 ifw=3thenco=9:ro=22:gosub790:print"4 4 4 4 5 5 5 5 5 5 5 5 5 5 6"
  110. 440 ifw=3thenprinttab(9)"6 7 8 9 0 1 2 3 4 5 6 7 8 9 0";
  111. 442 ifw=3thenprintchr$(158);:return
  112. 445 rem-write to disc
  113. 447 ifdf=0thengosub60000:return
  114. 450 printchr$(147);"the graph being recorded is titled":print:printt$
  115. 455 open2,8,2,"@0:"+t$+",s,w"
  116. 460 print#2,z
  117. 465 print#2,b
  118. 470 print#2,s
  119. 475 print#2,t$
  120. 480 print#2,x$
  121. 485 print#2,e
  122. 490 fori=1toe
  123. 495 print#2,g(i)
  124. 500 print#2,c(i)
  125. 505 next
  126. 510 close2
  127. 515 return
  128. 520 rem-read from tape
  129. 525 printchr$(147)
  130. 530 input"graph title";t$
  131. 535 open2,8,2,"0:"+t$+",s,r"
  132. 540 open15,8,15:input#15,e,er$,b1,c:ife<20then555
  133. 545 print"file not found. try again!":fort=1to2000:next:close2:close15
  134. 550 goto530
  135. 555 input#2,z
  136. 560 input#2,b
  137. 565 input#2,s
  138. 570 input#2,t$
  139. 575 input#2,x$
  140. 580 input#2,e
  141. 585 fori=1toe
  142. 590 input#2,g(i)
  143. 595 input#2,c(i)
  144. 600 next
  145. 605 close2:close15
  146. 610 return
  147. 615 h=0:rem-list current data
  148. 617 ifdf=0thengosub60000:return
  149. 620 printchr$(147):printtab(20-int(len(t$)/2))t$
  150. 625 ifh=1thenh=0:next
  151. 630 tt=0:ll=99999999:hh=.000000001
  152. 635 fori=1toe-1:tt=tt+g(i):ifg(i)<llthenll=g(i)
  153. 640 ifg(i)>hhthenhh=g(i)
  154. 645 printtab(2)x$;i;tab(30-len(str$(int(g(i)))))g(i)
  155. 650 ifi=15ori=30ori=45thenh=1:ff=0:goto680
  156. 655 next
  157. 660 print:print"end of file"
  158. 665 print:print"high value was  "hh
  159. 670 print"low value was   "ll
  160. 675 print"average value=  ";int((100*tt/(e-1))+.5)/100:ff=1
  161. 680 co=12:ro=24:gosub790:print"press any key";
  162. 685 geta$:ifa$=""then685
  163. 690 ifff=1then15
  164. 695 ifi=zandi=15ori=zandi=30ori=zandi=45thenco=0:ro=16:gosub790:goto660
  165. 700 goto620
  166. 705 rem-change prior entry
  167. 710 printchr$(147):print
  168. 715 printtab(2)"which entry #:  ";:u=1:gosub950:d=val(b$)
  169. 720 print:printtab(2)"entry # ";d;" is now"g(d)
  170. 725 print:printtab(2)"enter new value:  ";:u=1:gosub950:g(d)=val(b$)
  171. 730 print:printtab(2)"entry #"d"is now"g(d)
  172. 735 print:printtab(2)"color is now key #"c(d)
  173. 740 print:printtab(2)"enter new color key #:  ";:u=1:gosub950:c(d)=val(b$)
  174. 745 fort=1to1000:next
  175. 750 goto15
  176. 755 rem format change
  177. 760 printchr$(147):co=2:ro=6:gosub790
  178. 762 printtab(2)"value of bottom axis is ";b
  179. 765 print:printtab(2)"enter new value:  ";:u=1:gosub950:b=val(b$)
  180. 770 print:printtab(2)"value of vertical interval is ";s
  181. 775 print:printtab(2)"enter new value:  ";:u=1:gosub950:s=val(b$):return
  182. 780 print"                                       "
  183. 785 co=2:ro=20:gosub790:print"bad entry":fort=1to1000:next:return
  184. 790 rem cursor positioning sub-routine
  185. 795 printchr$(19)
  186. 800 ifro<>0thenpoke214,ro-1:print
  187. 805 poke211,co
  188. 810 return
  189. 815 rem screen copy
  190. 820 si$=chr$(15):bs$=chr$(8):po$=chr$(16)
  191. 825 rv$=chr$(18):ro$=chr$(146):qt$=chr$(34)
  192. 830 mf$=chr$(145):vr=peek(648)*256
  193. 835 open4,4:print#4
  194. 840 forcl=0to23:qf=0:as$=mf$:forro=0to39
  195. 845 sc=peek(vr+40*cl+ro)
  196. 850 ifsc=34thenqf=1-qf
  197. 855 ifsc<>162then870
  198. 860 qf=1-qf:ifqf=1thenas$=as$+rv$+qt$:goto900
  199. 865 as$=as$+qt$+ro$:goto900
  200. 870 ifqf=1and(sc>=128)thensc=sc-128:goto880
  201. 875 ifsc>128thensc=sc-128:rf=1:as$=as$+rv$
  202. 880 ifsc<32orsc>95thenas=sc+64:goto895
  203. 885 ifsc>31andsc<64thenas=sc:goto895
  204. 890 ifsc>63andsc<96thenas=sc+32:goto895
  205. 895 as$=as$+chr$(as)
  206. 900 ifrf=1thenas$=as$+ro$:rf=0
  207. 905 nextro
  208. 910 ifqf=0thenprint#4,si$po$"20"as$bs$:goto920
  209. 915 print#4,si$+po$+"20"+as$+qt$bs$
  210. 920 nextcl:print#4,si$:close4:return
  211. 950 rem input subroutine
  212. 955 cb=0:q=18:b$="":a$=""
  213. 960 geta$:ifa$=chr$(13)then975
  214. 965 q=164-q
  215. 970 printchr$(q)chr$(32)chr$(146)chr$(157);
  216. 975 ifb$=""anda$=chr$(13)then960:rem prevents entering null
  217. 980 ifb$=""anda$=chr$(20)then960:rem no delete if no letters are present
  218. 985 ifa$=chr$(17)ora$=chr$(29)ora$=chr$(145)ora$=chr$(157)then960
  219. 990 ifa$=":"ora$=","ora$>chr$(127)ora$=chr$(19)then960
  220. 995 ifa$=chr$(13)thenprintchr$(32):u=0:return
  221. 1000 ifu=1then1024
  222. 1005 printa$;:b$=b$+a$
  223. 1010 l=len(b$)
  224. 1015 ifa$=chr$(20)thenb$=le